home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / prim / find-func.el.z / find-func.el
Encoding:
Text File  |  1998-05-21  |  9.2 KB  |  258 lines
  1. ;;; find-func.el --- find the definition of the Emacs Lisp function near point
  2.  
  3. ;; Copyright (C) 1997 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
  6. ;; Maintainer: petersen@kurims.kyoto-u.ac.jp
  7. ;; Keywords: emacs-lisp, functions
  8. ;; Created: 97/07/25
  9. ;; URL: <http://www.kurims.kyoto-u.ac.jp/~petersen/emacs-lisp/>
  10.  
  11. ;; $Id: find-func.el,v 0.18 1997/10/18 10:24:35 petersen Exp $
  12.  
  13. ;; This file is part of XEmacs.
  14.  
  15. ;; XEmacs is free software; you can redistribute it and/or modify it
  16. ;; under the terms of the GNU General Public License as published by
  17. ;; the Free Software Foundation; either version 2, or (at your option)
  18. ;; any later version.
  19.  
  20. ;; XEmacs is distributed in the hope that it will be useful, but
  21. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  22. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  23. ;; General Public License for more details.
  24.  
  25. ;; You should have received a copy of the GNU General Public License
  26. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  27. ;; Free Software Foundation, 59 Temple Place - Suite 330,
  28. ;; Boston, MA 02111-1307, USA.
  29.  
  30. ;;; Commentary:
  31. ;;
  32. ;; The funniest thing about this is that I can't imagine why a package
  33. ;; so obviously useful as this hasn't been written before!!
  34. ;;
  35. ;; Put this file in your `load-path', byte-compile it and add the
  36. ;; following code in your init file:
  37. ;;
  38. ;; ;;; find-func
  39. ;; (load "find-func")
  40. ;; (global-set-key [(control ?c) ?f] 'find-function)
  41. ;; (global-set-key [(control ?c) ?4 ?f] 'find-function-other-window)
  42. ;; (global-set-key [(control ?c) ?5 ?f] 'find-function-other-frame)
  43. ;; (global-set-key [(control ?c) ?k] 'find-function-on-key)
  44. ;;
  45. ;; and away you go!  It does pretty much what you would expect,
  46. ;; putting the cursor at the definition of the function at point.
  47. ;;
  48. ;; In XEmacs the source file of dumped functions is recorded (and can
  49. ;; be accessed with the function `compiled-function-annotation', which
  50. ;; doesn't exist in Emacs), so in XEmacs non-primitive dumped
  51. ;; functions can also be found.  Unfortunately this is not possible in
  52. ;; Emacs.  It would be nice if the location of primitive functions in
  53. ;; the C code was also recorded!
  54.  
  55. ;; The code is adapted from `describe-function', `describe-key'
  56. ;; ("help.el") and `fff-find-loaded-emacs-lisp-function' (Noah Friedman's
  57. ;; "fff.el").
  58.  
  59. ;;; To do:
  60. ;;
  61. ;; o improve handling of advice'd functions? (at the moment it goes to
  62. ;; the advice, not the actual definition)
  63. ;;
  64. ;; o `find-function-other-frame' is not quite right when the function
  65. ;; is in the current buffer.
  66. ;;
  67. ;;;; Code:
  68.  
  69. (defgroup find-function nil
  70.   "Find the definition of the Emacs Lisp function near point."
  71.   :group 'lisp)
  72.  
  73. ;;; User variables:
  74.  
  75. (defcustom find-function-source-path nil
  76.   "The default list of directories where find-function searches.
  77.  
  78. If this variable is `nil' then find-function searches `load-path' by
  79. default."
  80.   :type '(choice (const :tag "Use `load-path'" nil)
  81.          (repeat :tag "Directories"
  82.              :menu-tag "List"
  83.              :value ("")
  84.              directory))
  85.   :group 'find-function)
  86.  
  87.  
  88. ;;; Functions:
  89.  
  90. (defun find-function-noselect (function)
  91.   "Returns a pair `(buffer . point)' pointing to the definition of FUNCTION.
  92.  
  93. Finds the Emacs Lisp library containing the definition of FUNCTION
  94. in a buffer and the point of the definition.  The buffer is
  95. not selected.
  96.  
  97. The library where FUNCTION is defined is searched for in
  98. `find-function-source-path', if non `nil', otherwise in `load-path'."
  99.   (if (not function)
  100.       (error "You didn't specify a function"))
  101.   (and (subrp (symbol-function function))
  102.        (error "%s is a primitive function" function))
  103.   (let ((def (symbol-function function))
  104.     library aliases)
  105.     (while (symbolp def)
  106.       (or (eq def function)
  107.       (if aliases
  108.           (setq aliases (concat aliases
  109.                     (format ", which is an alias for %s"
  110.                         (symbol-name def))))
  111.         (setq aliases (format "an alias for %s" (symbol-name def)))))
  112.       (setq function (symbol-function function)
  113.         def (symbol-function function)))
  114.     (if aliases
  115.     (message aliases))
  116.     (setq library
  117.       (cond ((eq (car-safe def) 'autoload)
  118.          (nth 1 def))
  119.         ((describe-function-find-file function))
  120.         ((compiled-function-p def)
  121.          (substring (compiled-function-annotation def) 0 -4))
  122.         ((eq 'macro (car-safe def))
  123.          (and (compiled-function-p (cdr def))
  124.               (substring (compiled-function-annotation (cdr def)) 0 -4)))))
  125.     (if (null library)
  126.     (error (format "Don't know where `%s' is defined" function)))
  127.     (if (string-match "\\.el\\(c\\)\\'" library)
  128.     (setq library (substring library 0 (match-beginning 1))))
  129.     (let* ((path find-function-source-path)
  130.        (filename (if (file-exists-p library)
  131.              library
  132.                (if (string-match "\\(\\.el\\)\\'" library)
  133.                (setq library (substring library 0
  134.                             (match-beginning
  135.                              1))))
  136.                (or (locate-library (concat library ".el") t path)
  137.                (locate-library library t path)))))
  138.       (if (not filename)
  139.       (error "The library \"%s\" is not in the path." library))
  140.       (with-current-buffer (find-file-noselect filename)
  141.     (save-match-data
  142.       (let (;; avoid defconst, defgroup, defvar (any others?)
  143.         (regexp
  144.          (format "^\\s-*(def[^cgv\W]\\w+\\*?\\s-+%s\\s-"
  145.              (regexp-quote (symbol-name function))))
  146.         (syntable (syntax-table)))
  147.         (set-syntax-table emacs-lisp-mode-syntax-table)
  148.         (goto-char (point-min))
  149.         (if (prog1
  150.             (re-search-forward regexp nil t)
  151.           (set-syntax-table syntable))
  152.         (progn
  153.           (beginning-of-line)
  154.           (cons (current-buffer) (point)))
  155.           (error "Cannot find definition of `%s'" function))))))))
  156.  
  157. (defun find-function-read-function ()
  158.   "Read and return a function, defaulting to the one near point.
  159.  
  160. `function-at-point' is used to select the default function."
  161.   (let ((fn (function-at-point))
  162.     (enable-recursive-minibuffers t)
  163.     val)
  164.     (setq val (completing-read
  165.            (if fn
  166.            (format "Find function (default %s): " fn)
  167.          "Find function: ")
  168.            obarray 'fboundp t nil 'function-history))
  169.     (list (if (equal val "")
  170.           fn (intern val)))))
  171.  
  172. (defun find-function-do-it (function switch-fn)
  173.   "Find Emacs Lisp FUNCTION in a buffer and display it with SWITCH-FN.
  174. Point is saved in the buffer if it is one of the current buffers."
  175.   (let ((orig-point (point))
  176.     (orig-buffers (buffer-list))
  177.     (buffer-point (find-function-noselect function)))
  178.     (when buffer-point
  179.       (funcall switch-fn (car buffer-point))
  180.       (when (memq (car buffer-point) orig-buffers)
  181.     (push-mark orig-point))
  182.       (goto-char (cdr buffer-point))
  183.       (recenter 0))))
  184.  
  185. ;;;###autoload
  186. (defun find-function (function)
  187.   "Find the definition of the function near point in the current window.
  188.  
  189. Finds the Emacs Lisp library containing the definition of the function
  190. near point (selected by `function-at-point') in a buffer and
  191. places point before the definition.  Point is saved in the buffer if
  192. it is one of the current buffers.
  193.  
  194. The library where FUNCTION is defined is searched for in
  195. `find-function-source-path', if non `nil', otherwise in `load-path'."
  196.   (interactive (find-function-read-function))
  197.   (find-function-do-it function 'switch-to-buffer))
  198.  
  199. ;;;###autoload
  200. (defun find-function-other-window (function)
  201.   "Find the definition of the function near point in the other window.
  202.  
  203. Finds the Emacs Lisp library containing the definition of the function
  204. near point (selected by `function-at-point') in a buffer and
  205. places point before the definition.  Point is saved in the buffer if
  206. it is one of the current buffers.
  207.  
  208. The library where FUNCTION is defined is searched for in
  209. `find-function-source-path', if non `nil', otherwise in `load-path'."
  210.   (interactive (find-function-read-function))
  211.   (find-function-do-it function 'switch-to-buffer-other-window))
  212.  
  213. ;;;###autoload
  214. (defun find-function-other-frame (function)
  215.   "Find the definition of the function near point in the another frame.
  216.  
  217. Finds the Emacs Lisp library containing the definition of the function
  218. near point (selected by `function-at-point') in a buffer and
  219. places point before the definition.  Point is saved in the buffer if
  220. it is one of the current buffers.
  221.  
  222. The library where FUNCTION is defined is searched for in
  223. `find-function-source-path', if non `nil', otherwise in `load-path'."
  224.   (interactive (find-function-read-function))
  225.   (find-function-do-it function 'switch-to-buffer-other-frame))
  226.  
  227. ;;;###autoload
  228. (defun find-function-on-key (key)
  229.   "Find the function that KEY invokes.  KEY is a string.
  230. Point is saved if FUNCTION is in the current buffer."
  231.   (interactive "kFind function on key: ")
  232.   (let ((defn (key-or-menu-binding key)))
  233.     (if (or (null defn) (integerp defn))
  234.         (message "%s is undefined" (key-description key))
  235.       (if (and (consp defn) (not (eq 'lambda (car-safe defn))))
  236.       (message "runs %s" (prin1-to-string defn))
  237.     (find-function-other-window defn)))))
  238.  
  239. ;;;###autoload
  240. (defun find-function-at-point ()
  241.   "Find directly the function at point in the other window."
  242.   (interactive)
  243.   (let ((symb (function-at-point)))
  244.     (when symb
  245.       (find-function-other-window symb))))
  246.  
  247. ;; (define-key ctl-x-map "F" 'find-function) ; conflicts with `facemenu-keymap'
  248.  
  249. ;;;###autoload
  250. (define-key ctl-x-4-map "F" 'find-function-other-window)
  251. ;;;###autoload
  252. (define-key ctl-x-5-map "F" 'find-function-other-frame)
  253. ;;;###autoload
  254. (define-key ctl-x-map "K" 'find-function-on-key)
  255.  
  256. (provide 'find-func)
  257. ;;; find-func.el ends here
  258.